<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
 <head>
  <title>slarrd.f</title>
 <meta name="generator" content="emacs 21.3.1; htmlfontify 0.20">
<style type="text/css"><!-- 
body { background: rgb(255, 255, 255);  color: rgb(0, 0, 0);  font-style: normal;  font-weight: 500;  font-stretch: normal;  font-family: adobe-courier;  font-size: 11pt;  text-decoration: none; }
span.default   { background: rgb(255, 255, 255);  color: rgb(0, 0, 0);  font-style: normal;  font-weight: 500;  font-stretch: normal;  font-family: adobe-courier;  font-size: 11pt;  text-decoration: none; }
span.default a { background: rgb(255, 255, 255);  color: rgb(0, 0, 0);  font-style: normal;  font-weight: 500;  font-stretch: normal;  font-family: adobe-courier;  font-size: 11pt;  text-decoration: underline; }
span.string   { color: rgb(188, 143, 143);  background: rgb(255, 255, 255);  font-style: normal;  font-weight: 500;  font-stretch: normal;  font-family: adobe-courier;  font-size: 11pt;  text-decoration: none; }
span.string a { color: rgb(188, 143, 143);  background: rgb(255, 255, 255);  font-style: normal;  font-weight: 500;  font-stretch: normal;  font-family: adobe-courier;  font-size: 11pt;  text-decoration: underline; }
span.comment   { color: rgb(178, 34, 34);  background: rgb(255, 255, 255);  font-style: normal;  font-weight: 500;  font-stretch: normal;  font-family: adobe-courier;  font-size: 11pt;  text-decoration: none; }
span.comment a { color: rgb(178, 34, 34);  background: rgb(255, 255, 255);  font-style: normal;  font-weight: 500;  font-stretch: normal;  font-family: adobe-courier;  font-size: 11pt;  text-decoration: underline; }
 --></style>

 </head>
  <body>

<pre>
      SUBROUTINE <a name="SLARRD.1"></a><a href="slarrd.f.html#SLARRD.1">SLARRD</a>( RANGE, ORDER, N, VL, VU, IL, IU, GERS,
     $                    RELTOL, D, E, E2, PIVMIN, NSPLIT, ISPLIT,
     $                    M, W, WERR, WL, WU, IBLOCK, INDEXW,
     $                    WORK, IWORK, INFO )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  -- LAPACK auxiliary routine (version 3.1) --
</span><span class="comment">*</span><span class="comment">     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
</span><span class="comment">*</span><span class="comment">     November 2006
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     .. Scalar Arguments ..
</span>      CHARACTER          ORDER, RANGE
      INTEGER            IL, INFO, IU, M, N, NSPLIT
      REAL                PIVMIN, RELTOL, VL, VU, WL, WU
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. Array Arguments ..
</span>      INTEGER            IBLOCK( * ), INDEXW( * ),
     $                   ISPLIT( * ), IWORK( * )
      REAL               D( * ), E( * ), E2( * ),
     $                   GERS( * ), W( * ), WERR( * ), WORK( * )
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  Purpose
</span><span class="comment">*</span><span class="comment">  =======
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  <a name="SLARRD.25"></a><a href="slarrd.f.html#SLARRD.1">SLARRD</a> computes the eigenvalues of a symmetric tridiagonal
</span><span class="comment">*</span><span class="comment">  matrix T to suitable accuracy. This is an auxiliary code to be
</span><span class="comment">*</span><span class="comment">  called from <a name="SSTEMR.27"></a><a href="sstemr.f.html#SSTEMR.1">SSTEMR</a>.
</span><span class="comment">*</span><span class="comment">  The user may ask for all eigenvalues, all eigenvalues
</span><span class="comment">*</span><span class="comment">  in the half-open interval (VL, VU], or the IL-th through IU-th
</span><span class="comment">*</span><span class="comment">  eigenvalues.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  To avoid overflow, the matrix must be scaled so that its
</span><span class="comment">*</span><span class="comment">  largest element is no greater than overflow**(1/2) *
</span><span class="comment">*</span><span class="comment">  underflow**(1/4) in absolute value, and for greatest
</span><span class="comment">*</span><span class="comment">  accuracy, it should not be much smaller than that.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  See W. Kahan &quot;Accurate Eigenvalues of a Symmetric Tridiagonal
</span><span class="comment">*</span><span class="comment">  Matrix&quot;, Report CS41, Computer Science Dept., Stanford
</span><span class="comment">*</span><span class="comment">  University, July 21, 1966.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  Arguments
</span><span class="comment">*</span><span class="comment">  =========
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  RANGE   (input) CHARACTER
</span><span class="comment">*</span><span class="comment">          = 'A': (&quot;All&quot;)   all eigenvalues will be found.
</span><span class="comment">*</span><span class="comment">          = 'V': (&quot;Value&quot;) all eigenvalues in the half-open interval
</span><span class="comment">*</span><span class="comment">                           (VL, VU] will be found.
</span><span class="comment">*</span><span class="comment">          = 'I': (&quot;Index&quot;) the IL-th through IU-th eigenvalues (of the
</span><span class="comment">*</span><span class="comment">                           entire matrix) will be found.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  ORDER   (input) CHARACTER
</span><span class="comment">*</span><span class="comment">          = 'B': (&quot;By Block&quot;) the eigenvalues will be grouped by
</span><span class="comment">*</span><span class="comment">                              split-off block (see IBLOCK, ISPLIT) and
</span><span class="comment">*</span><span class="comment">                              ordered from smallest to largest within
</span><span class="comment">*</span><span class="comment">                              the block.
</span><span class="comment">*</span><span class="comment">          = 'E': (&quot;Entire matrix&quot;)
</span><span class="comment">*</span><span class="comment">                              the eigenvalues for the entire matrix
</span><span class="comment">*</span><span class="comment">                              will be ordered from smallest to
</span><span class="comment">*</span><span class="comment">                              largest.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  N       (input) INTEGER
</span><span class="comment">*</span><span class="comment">          The order of the tridiagonal matrix T.  N &gt;= 0.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  VL      (input) REAL            
</span><span class="comment">*</span><span class="comment">  VU      (input) REAL            
</span><span class="comment">*</span><span class="comment">          If RANGE='V', the lower and upper bounds of the interval to
</span><span class="comment">*</span><span class="comment">          be searched for eigenvalues.  Eigenvalues less than or equal
</span><span class="comment">*</span><span class="comment">          to VL, or greater than VU, will not be returned.  VL &lt; VU.
</span><span class="comment">*</span><span class="comment">          Not referenced if RANGE = 'A' or 'I'.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  IL      (input) INTEGER
</span><span class="comment">*</span><span class="comment">  IU      (input) INTEGER
</span><span class="comment">*</span><span class="comment">          If RANGE='I', the indices (in ascending order) of the
</span><span class="comment">*</span><span class="comment">          smallest and largest eigenvalues to be returned.
</span><span class="comment">*</span><span class="comment">          1 &lt;= IL &lt;= IU &lt;= N, if N &gt; 0; IL = 1 and IU = 0 if N = 0.
</span><span class="comment">*</span><span class="comment">          Not referenced if RANGE = 'A' or 'V'.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  GERS    (input) REAL             array, dimension (2*N)
</span><span class="comment">*</span><span class="comment">          The N Gerschgorin intervals (the i-th Gerschgorin interval
</span><span class="comment">*</span><span class="comment">          is (GERS(2*i-1), GERS(2*i)).
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  RELTOL  (input) REAL            
</span><span class="comment">*</span><span class="comment">          The minimum relative width of an interval.  When an interval
</span><span class="comment">*</span><span class="comment">          is narrower than RELTOL times the larger (in
</span><span class="comment">*</span><span class="comment">          magnitude) endpoint, then it is considered to be
</span><span class="comment">*</span><span class="comment">          sufficiently small, i.e., converged.  Note: this should
</span><span class="comment">*</span><span class="comment">          always be at least radix*machine epsilon.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  D       (input) REAL             array, dimension (N)
</span><span class="comment">*</span><span class="comment">          The n diagonal elements of the tridiagonal matrix T.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  E       (input) REAL             array, dimension (N-1)
</span><span class="comment">*</span><span class="comment">          The (n-1) off-diagonal elements of the tridiagonal matrix T.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  E2      (input) REAL             array, dimension (N-1)
</span><span class="comment">*</span><span class="comment">          The (n-1) squared off-diagonal elements of the tridiagonal matrix T.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  PIVMIN  (input) REAL            
</span><span class="comment">*</span><span class="comment">          The minimum pivot allowed in the Sturm sequence for T.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  NSPLIT  (input) INTEGER
</span><span class="comment">*</span><span class="comment">          The number of diagonal blocks in the matrix T.
</span><span class="comment">*</span><span class="comment">          1 &lt;= NSPLIT &lt;= N.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  ISPLIT  (input) INTEGER array, dimension (N)
</span><span class="comment">*</span><span class="comment">          The splitting points, at which T breaks up into submatrices.
</span><span class="comment">*</span><span class="comment">          The first submatrix consists of rows/columns 1 to ISPLIT(1),
</span><span class="comment">*</span><span class="comment">          the second of rows/columns ISPLIT(1)+1 through ISPLIT(2),
</span><span class="comment">*</span><span class="comment">          etc., and the NSPLIT-th consists of rows/columns
</span><span class="comment">*</span><span class="comment">          ISPLIT(NSPLIT-1)+1 through ISPLIT(NSPLIT)=N.
</span><span class="comment">*</span><span class="comment">          (Only the first NSPLIT elements will actually be used, but
</span><span class="comment">*</span><span class="comment">          since the user cannot know a priori what value NSPLIT will
</span><span class="comment">*</span><span class="comment">          have, N words must be reserved for ISPLIT.)
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  M       (output) INTEGER
</span><span class="comment">*</span><span class="comment">          The actual number of eigenvalues found. 0 &lt;= M &lt;= N.
</span><span class="comment">*</span><span class="comment">          (See also the description of INFO=2,3.)
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  W       (output) REAL             array, dimension (N)
</span><span class="comment">*</span><span class="comment">          On exit, the first M elements of W will contain the
</span><span class="comment">*</span><span class="comment">          eigenvalue approximations. <a name="SLARRD.121"></a><a href="slarrd.f.html#SLARRD.1">SLARRD</a> computes an interval
</span><span class="comment">*</span><span class="comment">          I_j = (a_j, b_j] that includes eigenvalue j. The eigenvalue
</span><span class="comment">*</span><span class="comment">          approximation is given as the interval midpoint
</span><span class="comment">*</span><span class="comment">          W(j)= ( a_j + b_j)/2. The corresponding error is bounded by
</span><span class="comment">*</span><span class="comment">          WERR(j) = abs( a_j - b_j)/2
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  WERR    (output) REAL             array, dimension (N)
</span><span class="comment">*</span><span class="comment">          The error bound on the corresponding eigenvalue approximation
</span><span class="comment">*</span><span class="comment">          in W.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  WL      (output) REAL            
</span><span class="comment">*</span><span class="comment">  WU      (output) REAL            
</span><span class="comment">*</span><span class="comment">          The interval (WL, WU] contains all the wanted eigenvalues.
</span><span class="comment">*</span><span class="comment">          If RANGE='V', then WL=VL and WU=VU.
</span><span class="comment">*</span><span class="comment">          If RANGE='A', then WL and WU are the global Gerschgorin bounds
</span><span class="comment">*</span><span class="comment">                        on the spectrum.
</span><span class="comment">*</span><span class="comment">          If RANGE='I', then WL and WU are computed by <a name="SLAEBZ.137"></a><a href="slaebz.f.html#SLAEBZ.1">SLAEBZ</a> from the
</span><span class="comment">*</span><span class="comment">                        index range specified.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  IBLOCK  (output) INTEGER array, dimension (N)
</span><span class="comment">*</span><span class="comment">          At each row/column j where E(j) is zero or small, the
</span><span class="comment">*</span><span class="comment">          matrix T is considered to split into a block diagonal
</span><span class="comment">*</span><span class="comment">          matrix.  On exit, if INFO = 0, IBLOCK(i) specifies to which
</span><span class="comment">*</span><span class="comment">          block (from 1 to the number of blocks) the eigenvalue W(i)
</span><span class="comment">*</span><span class="comment">          belongs.  (<a name="SLARRD.145"></a><a href="slarrd.f.html#SLARRD.1">SLARRD</a> may use the remaining N-M elements as
</span><span class="comment">*</span><span class="comment">          workspace.)
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  INDEXW  (output) INTEGER array, dimension (N)
</span><span class="comment">*</span><span class="comment">          The indices of the eigenvalues within each block (submatrix);
</span><span class="comment">*</span><span class="comment">          for example, INDEXW(i)= j and IBLOCK(i)=k imply that the
</span><span class="comment">*</span><span class="comment">          i-th eigenvalue W(i) is the j-th eigenvalue in block k.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  WORK    (workspace) REAL             array, dimension (4*N)
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  IWORK   (workspace) INTEGER array, dimension (3*N)
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  INFO    (output) INTEGER
</span><span class="comment">*</span><span class="comment">          = 0:  successful exit
</span><span class="comment">*</span><span class="comment">          &lt; 0:  if INFO = -i, the i-th argument had an illegal value
</span><span class="comment">*</span><span class="comment">          &gt; 0:  some or all of the eigenvalues failed to converge or
</span><span class="comment">*</span><span class="comment">                were not computed:
</span><span class="comment">*</span><span class="comment">                =1 or 3: Bisection failed to converge for some
</span><span class="comment">*</span><span class="comment">                        eigenvalues; these eigenvalues are flagged by a
</span><span class="comment">*</span><span class="comment">                        negative block number.  The effect is that the
</span><span class="comment">*</span><span class="comment">                        eigenvalues may not be as accurate as the
</span><span class="comment">*</span><span class="comment">                        absolute and relative tolerances.  This is
</span><span class="comment">*</span><span class="comment">                        generally caused by unexpectedly inaccurate
</span><span class="comment">*</span><span class="comment">                        arithmetic.
</span><span class="comment">*</span><span class="comment">                =2 or 3: RANGE='I' only: Not all of the eigenvalues
</span><span class="comment">*</span><span class="comment">                        IL:IU were found.
</span><span class="comment">*</span><span class="comment">                        Effect: M &lt; IU+1-IL
</span><span class="comment">*</span><span class="comment">                        Cause:  non-monotonic arithmetic, causing the
</span><span class="comment">*</span><span class="comment">                                Sturm sequence to be non-monotonic.
</span><span class="comment">*</span><span class="comment">                        Cure:   recalculate, using RANGE='A', and pick
</span><span class="comment">*</span><span class="comment">                                out eigenvalues IL:IU.  In some cases,
</span><span class="comment">*</span><span class="comment">                                increasing the PARAMETER &quot;FUDGE&quot; may
</span><span class="comment">*</span><span class="comment">                                make things work.
</span><span class="comment">*</span><span class="comment">                = 4:    RANGE='I', and the Gershgorin interval
</span><span class="comment">*</span><span class="comment">                        initially used was too small.  No eigenvalues
</span><span class="comment">*</span><span class="comment">                        were computed.
</span><span class="comment">*</span><span class="comment">                        Probable cause: your machine has sloppy
</span><span class="comment">*</span><span class="comment">                                        floating-point arithmetic.
</span><span class="comment">*</span><span class="comment">                        Cure: Increase the PARAMETER &quot;FUDGE&quot;,
</span><span class="comment">*</span><span class="comment">                              recompile, and try again.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  Internal Parameters
</span><span class="comment">*</span><span class="comment">  ===================
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  FUDGE   REAL            , default = 2
</span><span class="comment">*</span><span class="comment">          A &quot;fudge factor&quot; to widen the Gershgorin intervals.  Ideally,
</span><span class="comment">*</span><span class="comment">          a value of 1 should work, but on machines with sloppy
</span><span class="comment">*</span><span class="comment">          arithmetic, this needs to be larger.  The default for
</span><span class="comment">*</span><span class="comment">          publicly released versions should be large enough to handle
</span><span class="comment">*</span><span class="comment">          the worst machine around.  Note that this has no effect
</span><span class="comment">*</span><span class="comment">          on accuracy of the solution.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  Based on contributions by
</span><span class="comment">*</span><span class="comment">     W. Kahan, University of California, Berkeley, USA
</span><span class="comment">*</span><span class="comment">     Beresford Parlett, University of California, Berkeley, USA
</span><span class="comment">*</span><span class="comment">     Jim Demmel, University of California, Berkeley, USA
</span><span class="comment">*</span><span class="comment">     Inderjit Dhillon, University of Texas, Austin, USA
</span><span class="comment">*</span><span class="comment">     Osni Marques, LBNL/NERSC, USA
</span><span class="comment">*</span><span class="comment">     Christof Voemel, University of California, Berkeley, USA
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">  =====================================================================
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     .. Parameters ..
</span>      REAL               ZERO, ONE, TWO, HALF, FUDGE
      PARAMETER          ( ZERO = 0.0E0, ONE = 1.0E0,
     $                     TWO = 2.0E0, HALF = ONE/TWO,
     $                     FUDGE = TWO )
      INTEGER   ALLRNG, VALRNG, INDRNG
      PARAMETER ( ALLRNG = 1, VALRNG = 2, INDRNG = 3 )
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. Local Scalars ..
</span>      LOGICAL            NCNVRG, TOOFEW
      INTEGER            I, IB, IBEGIN, IDISCL, IDISCU, IE, IEND, IINFO,
     $                   IM, IN, IOFF, IOUT, IRANGE, ITMAX, ITMP1,
     $                   ITMP2, IW, IWOFF, J, JBLK, JDISC, JE, JEE, NB,
     $                   NWL, NWU
      REAL               ATOLI, EPS, GL, GU, RTOLI, SPDIAM, TMP1, TMP2,
     $                   TNORM, UFLOW, WKILL, WLU, WUL

<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. Local Arrays ..
</span>      INTEGER            IDUMMA( 1 )
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. External Functions ..
</span>      LOGICAL            <a name="LSAME.229"></a><a href="lsame.f.html#LSAME.1">LSAME</a>
      INTEGER            <a name="ILAENV.230"></a><a href="ilaenv.f.html#ILAENV.1">ILAENV</a>
      REAL               <a name="SLAMCH.231"></a><a href="slamch.f.html#SLAMCH.1">SLAMCH</a>
      EXTERNAL           <a name="LSAME.232"></a><a href="lsame.f.html#LSAME.1">LSAME</a>, <a name="ILAENV.232"></a><a href="ilaenv.f.html#ILAENV.1">ILAENV</a>, <a name="SLAMCH.232"></a><a href="slamch.f.html#SLAMCH.1">SLAMCH</a>
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. External Subroutines ..
</span>      EXTERNAL           <a name="SLAEBZ.235"></a><a href="slaebz.f.html#SLAEBZ.1">SLAEBZ</a>
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. Intrinsic Functions ..
</span>      INTRINSIC          ABS, INT, LOG, MAX, MIN
<span class="comment">*</span><span class="comment">     ..
</span><span class="comment">*</span><span class="comment">     .. Executable Statements ..
</span><span class="comment">*</span><span class="comment">
</span>      INFO = 0
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Decode RANGE
</span><span class="comment">*</span><span class="comment">
</span>      IF( <a name="LSAME.246"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( RANGE, <span class="string">'A'</span> ) ) THEN
         IRANGE = ALLRNG
      ELSE IF( <a name="LSAME.248"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( RANGE, <span class="string">'V'</span> ) ) THEN
         IRANGE = VALRNG
      ELSE IF( <a name="LSAME.250"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( RANGE, <span class="string">'I'</span> ) ) THEN
         IRANGE = INDRNG
      ELSE
         IRANGE = 0
      END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     Check for Errors
</span><span class="comment">*</span><span class="comment">
</span>      IF( IRANGE.LE.0 ) THEN
         INFO = -1
      ELSE IF( .NOT.(<a name="LSAME.260"></a><a href="lsame.f.html#LSAME.1">LSAME</a>(ORDER,<span class="string">'B'</span>).OR.<a name="LSAME.260"></a><a href="lsame.f.html#LSAME.1">LSAME</a>(ORDER,<span class="string">'E'</span>)) ) THEN
         INFO = -2
      ELSE IF( N.LT.0 ) THEN
         INFO = -3
      ELSE IF( IRANGE.EQ.VALRNG ) THEN
         IF( VL.GE.VU )
     $      INFO = -5
      ELSE IF( IRANGE.EQ.INDRNG .AND.
     $        ( IL.LT.1 .OR. IL.GT.MAX( 1, N ) ) ) THEN
         INFO = -6
      ELSE IF( IRANGE.EQ.INDRNG .AND.
     $        ( IU.LT.MIN( N, IL ) .OR. IU.GT.N ) ) THEN
         INFO = -7
      END IF
<span class="comment">*</span><span class="comment">
</span>      IF( INFO.NE.0 ) THEN
         RETURN
      END IF

<span class="comment">*</span><span class="comment">     Initialize error flags
</span>      INFO = 0
      NCNVRG = .FALSE.
      TOOFEW = .FALSE.

<span class="comment">*</span><span class="comment">     Quick return if possible
</span>      M = 0
      IF( N.EQ.0 ) RETURN

<span class="comment">*</span><span class="comment">     Simplification:
</span>      IF( IRANGE.EQ.INDRNG .AND. IL.EQ.1 .AND. IU.EQ.N ) IRANGE = 1

<span class="comment">*</span><span class="comment">     Get machine constants
</span>      EPS = <a name="SLAMCH.292"></a><a href="slamch.f.html#SLAMCH.1">SLAMCH</a>( <span class="string">'P'</span> )
      UFLOW = <a name="SLAMCH.293"></a><a href="slamch.f.html#SLAMCH.1">SLAMCH</a>( <span class="string">'U'</span> )


<span class="comment">*</span><span class="comment">     Special Case when N=1
</span><span class="comment">*</span><span class="comment">     Treat case of 1x1 matrix for quick return
</span>      IF( N.EQ.1 ) THEN
         IF( (IRANGE.EQ.ALLRNG).OR.
     $       ((IRANGE.EQ.VALRNG).AND.(D(1).GT.VL).AND.(D(1).LE.VU)).OR.
     $       ((IRANGE.EQ.INDRNG).AND.(IL.EQ.1).AND.(IU.EQ.1)) ) THEN
            M = 1
            W(1) = D(1)
<span class="comment">*</span><span class="comment">           The computation error of the eigenvalue is zero
</span>            WERR(1) = ZERO
            IBLOCK( 1 ) = 1
            INDEXW( 1 ) = 1
         ENDIF
         RETURN
      END IF

<span class="comment">*</span><span class="comment">     NB is the minimum vector length for vector bisection, or 0
</span><span class="comment">*</span><span class="comment">     if only scalar is to be done.
</span>      NB = <a name="ILAENV.314"></a><a href="ilaenv.f.html#ILAENV.1">ILAENV</a>( 1, <span class="string">'<a name="SSTEBZ.314"></a><a href="sstebz.f.html#SSTEBZ.1">SSTEBZ</a>'</span>, <span class="string">' '</span>, N, -1, -1, -1 )
      IF( NB.LE.1 ) NB = 0

<span class="comment">*</span><span class="comment">     Find global spectral radius
</span>      GL = D(1)
      GU = D(1)
      DO 5 I = 1,N
         GL =  MIN( GL, GERS( 2*I - 1))
         GU = MAX( GU, GERS(2*I) )
 5    CONTINUE
<span class="comment">*</span><span class="comment">     Compute global Gerschgorin bounds and spectral diameter
</span>      TNORM = MAX( ABS( GL ), ABS( GU ) )
      GL = GL - FUDGE*TNORM*EPS*N - FUDGE*TWO*PIVMIN
      GU = GU + FUDGE*TNORM*EPS*N + FUDGE*TWO*PIVMIN
      SPDIAM = GU - GL
<span class="comment">*</span><span class="comment">     Input arguments for <a name="SLAEBZ.329"></a><a href="slaebz.f.html#SLAEBZ.1">SLAEBZ</a>:
</span><span class="comment">*</span><span class="comment">     The relative tolerance.  An interval (a,b] lies within
</span><span class="comment">*</span><span class="comment">     &quot;relative tolerance&quot; if  b-a &lt; RELTOL*max(|a|,|b|),
</span>      RTOLI = RELTOL
<span class="comment">*</span><span class="comment">     Set the absolute tolerance for interval convergence to zero to force
</span><span class="comment">*</span><span class="comment">     interval convergence based on relative size of the interval.
</span><span class="comment">*</span><span class="comment">     This is dangerous because intervals might not converge when RELTOL is
</span><span class="comment">*</span><span class="comment">     small. But at least a very small number should be selected so that for
</span><span class="comment">*</span><span class="comment">     strongly graded matrices, the code can get relatively accurate
</span><span class="comment">*</span><span class="comment">     eigenvalues.
</span>      ATOLI = FUDGE*TWO*UFLOW + FUDGE*TWO*PIVMIN

      IF( IRANGE.EQ.INDRNG ) THEN

<span class="comment">*</span><span class="comment">        RANGE='I': Compute an interval containing eigenvalues
</span><span class="comment">*</span><span class="comment">        IL through IU. The initial interval [GL,GU] from the global
</span><span class="comment">*</span><span class="comment">        Gerschgorin bounds GL and GU is refined by <a name="SLAEBZ.345"></a><a href="slaebz.f.html#SLAEBZ.1">SLAEBZ</a>.
</span>         ITMAX = INT( ( LOG( TNORM+PIVMIN )-LOG( PIVMIN ) ) /
     $           LOG( TWO ) ) + 2
         WORK( N+1 ) = GL
         WORK( N+2 ) = GL
         WORK( N+3 ) = GU
         WORK( N+4 ) = GU
         WORK( N+5 ) = GL
         WORK( N+6 ) = GU
         IWORK( 1 ) = -1
         IWORK( 2 ) = -1
         IWORK( 3 ) = N + 1
         IWORK( 4 ) = N + 1
         IWORK( 5 ) = IL - 1
         IWORK( 6 ) = IU
<span class="comment">*</span><span class="comment">
</span>         CALL <a name="SLAEBZ.361"></a><a href="slaebz.f.html#SLAEBZ.1">SLAEBZ</a>( 3, ITMAX, N, 2, 2, NB, ATOLI, RTOLI, PIVMIN,
     $         D, E, E2, IWORK( 5 ), WORK( N+1 ), WORK( N+5 ), IOUT,
     $                IWORK, W, IBLOCK, IINFO )
         IF( IINFO .NE. 0 ) THEN
            INFO = IINFO
            RETURN
         END IF
<span class="comment">*</span><span class="comment">        On exit, output intervals may not be ordered by ascending negcount
</span>         IF( IWORK( 6 ).EQ.IU ) THEN
            WL = WORK( N+1 )
            WLU = WORK( N+3 )
            NWL = IWORK( 1 )
            WU = WORK( N+4 )
            WUL = WORK( N+2 )
            NWU = IWORK( 4 )
         ELSE
            WL = WORK( N+2 )
            WLU = WORK( N+4 )
            NWL = IWORK( 2 )
            WU = WORK( N+3 )
            WUL = WORK( N+1 )
            NWU = IWORK( 3 )
         END IF
<span class="comment">*</span><span class="comment">        On exit, the interval [WL, WLU] contains a value with negcount NWL,
</span><span class="comment">*</span><span class="comment">        and [WUL, WU] contains a value with negcount NWU.
</span>         IF( NWL.LT.0 .OR. NWL.GE.N .OR. NWU.LT.1 .OR. NWU.GT.N ) THEN
            INFO = 4
            RETURN
         END IF

      ELSEIF( IRANGE.EQ.VALRNG ) THEN
         WL = VL
         WU = VU

      ELSEIF( IRANGE.EQ.ALLRNG ) THEN
         WL = GL
         WU = GU
      ENDIF



<span class="comment">*</span><span class="comment">     Find Eigenvalues -- Loop Over blocks and recompute NWL and NWU.
</span><span class="comment">*</span><span class="comment">     NWL accumulates the number of eigenvalues .le. WL,
</span><span class="comment">*</span><span class="comment">     NWU accumulates the number of eigenvalues .le. WU
</span>      M = 0
      IEND = 0
      INFO = 0
      NWL = 0
      NWU = 0
<span class="comment">*</span><span class="comment">
</span>      DO 70 JBLK = 1, NSPLIT
         IOFF = IEND
         IBEGIN = IOFF + 1
         IEND = ISPLIT( JBLK )
         IN = IEND - IOFF
<span class="comment">*</span><span class="comment">
</span>         IF( IN.EQ.1 ) THEN
<span class="comment">*</span><span class="comment">           1x1 block
</span>            IF( WL.GE.D( IBEGIN )-PIVMIN )
     $         NWL = NWL + 1
            IF( WU.GE.D( IBEGIN )-PIVMIN )
     $         NWU = NWU + 1
            IF( IRANGE.EQ.ALLRNG .OR.
     $           ( WL.LT.D( IBEGIN )-PIVMIN
     $             .AND. WU.GE. D( IBEGIN )-PIVMIN ) ) THEN
               M = M + 1
               W( M ) = D( IBEGIN )
               WERR(M) = ZERO
<span class="comment">*</span><span class="comment">              The gap for a single block doesn't matter for the later
</span><span class="comment">*</span><span class="comment">              algorithm and is assigned an arbitrary large value
</span>               IBLOCK( M ) = JBLK
               INDEXW( M ) = 1
            END IF

<span class="comment">*</span><span class="comment">        Disabled 2x2 case because of a failure on the following matrix
</span><span class="comment">*</span><span class="comment">        RANGE = 'I', IL = IU = 4
</span><span class="comment">*</span><span class="comment">          Original Tridiagonal, d = [
</span><span class="comment">*</span><span class="comment">           -0.150102010615740E+00
</span><span class="comment">*</span><span class="comment">           -0.849897989384260E+00
</span><span class="comment">*</span><span class="comment">           -0.128208148052635E-15
</span><span class="comment">*</span><span class="comment">            0.128257718286320E-15
</span><span class="comment">*</span><span class="comment">          ];
</span><span class="comment">*</span><span class="comment">          e = [
</span><span class="comment">*</span><span class="comment">           -0.357171383266986E+00
</span><span class="comment">*</span><span class="comment">           -0.180411241501588E-15
</span><span class="comment">*</span><span class="comment">           -0.175152352710251E-15
</span><span class="comment">*</span><span class="comment">          ];
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">         ELSE IF( IN.EQ.2 ) THEN
</span><span class="comment">*</span><span class="comment">*           2x2 block
</span><span class="comment">*</span><span class="comment">            DISC = SQRT( (HALF*(D(IBEGIN)-D(IEND)))**2 + E(IBEGIN)**2 )
</span><span class="comment">*</span><span class="comment">            TMP1 = HALF*(D(IBEGIN)+D(IEND))
</span><span class="comment">*</span><span class="comment">            L1 = TMP1 - DISC
</span><span class="comment">*</span><span class="comment">            IF( WL.GE. L1-PIVMIN )
</span><span class="comment">*</span><span class="comment">     $         NWL = NWL + 1
</span><span class="comment">*</span><span class="comment">            IF( WU.GE. L1-PIVMIN )
</span><span class="comment">*</span><span class="comment">     $         NWU = NWU + 1
</span><span class="comment">*</span><span class="comment">            IF( IRANGE.EQ.ALLRNG .OR. ( WL.LT.L1-PIVMIN .AND. WU.GE.
</span><span class="comment">*</span><span class="comment">     $          L1-PIVMIN ) ) THEN
</span><span class="comment">*</span><span class="comment">               M = M + 1
</span><span class="comment">*</span><span class="comment">               W( M ) = L1
</span><span class="comment">*</span><span class="comment">*              The uncertainty of eigenvalues of a 2x2 matrix is very small
</span><span class="comment">*</span><span class="comment">               WERR( M ) = EPS * ABS( W( M ) ) * TWO
</span><span class="comment">*</span><span class="comment">               IBLOCK( M ) = JBLK
</span><span class="comment">*</span><span class="comment">               INDEXW( M ) = 1
</span><span class="comment">*</span><span class="comment">            ENDIF
</span><span class="comment">*</span><span class="comment">            L2 = TMP1 + DISC
</span><span class="comment">*</span><span class="comment">            IF( WL.GE. L2-PIVMIN )
</span><span class="comment">*</span><span class="comment">     $         NWL = NWL + 1
</span><span class="comment">*</span><span class="comment">            IF( WU.GE. L2-PIVMIN )
</span><span class="comment">*</span><span class="comment">     $         NWU = NWU + 1
</span><span class="comment">*</span><span class="comment">            IF( IRANGE.EQ.ALLRNG .OR. ( WL.LT.L2-PIVMIN .AND. WU.GE.
</span><span class="comment">*</span><span class="comment">     $          L2-PIVMIN ) ) THEN
</span><span class="comment">*</span><span class="comment">               M = M + 1
</span><span class="comment">*</span><span class="comment">               W( M ) = L2
</span><span class="comment">*</span><span class="comment">*              The uncertainty of eigenvalues of a 2x2 matrix is very small
</span><span class="comment">*</span><span class="comment">               WERR( M ) = EPS * ABS( W( M ) ) * TWO
</span><span class="comment">*</span><span class="comment">               IBLOCK( M ) = JBLK
</span><span class="comment">*</span><span class="comment">               INDEXW( M ) = 2
</span><span class="comment">*</span><span class="comment">            ENDIF
</span>         ELSE
<span class="comment">*</span><span class="comment">           General Case - block of size IN &gt;= 2
</span><span class="comment">*</span><span class="comment">           Compute local Gerschgorin interval and use it as the initial
</span><span class="comment">*</span><span class="comment">           interval for <a name="SLAEBZ.484"></a><a href="slaebz.f.html#SLAEBZ.1">SLAEBZ</a>
</span>            GU = D( IBEGIN )
            GL = D( IBEGIN )
            TMP1 = ZERO

            DO 40 J = IBEGIN, IEND
               GL =  MIN( GL, GERS( 2*J - 1))
               GU = MAX( GU, GERS(2*J) )
   40       CONTINUE
            SPDIAM = GU - GL
            GL = GL - FUDGE*SPDIAM*EPS*IN - FUDGE*PIVMIN
            GU = GU + FUDGE*SPDIAM*EPS*IN + FUDGE*PIVMIN
<span class="comment">*</span><span class="comment">
</span>            IF( IRANGE.GT.1 ) THEN
               IF( GU.LT.WL ) THEN
<span class="comment">*</span><span class="comment">                 the local block contains none of the wanted eigenvalues
</span>                  NWL = NWL + IN
                  NWU = NWU + IN
                  GO TO 70
               END IF
<span class="comment">*</span><span class="comment">              refine search interval if possible, only range (WL,WU] matters
</span>               GL = MAX( GL, WL )
               GU = MIN( GU, WU )
               IF( GL.GE.GU )
     $            GO TO 70
            END IF

<span class="comment">*</span><span class="comment">           Find negcount of initial interval boundaries GL and GU
</span>            WORK( N+1 ) = GL
            WORK( N+IN+1 ) = GU
            CALL <a name="SLAEBZ.514"></a><a href="slaebz.f.html#SLAEBZ.1">SLAEBZ</a>( 1, 0, IN, IN, 1, NB, ATOLI, RTOLI, PIVMIN,
     $                   D( IBEGIN ), E( IBEGIN ), E2( IBEGIN ),
     $                   IDUMMA, WORK( N+1 ), WORK( N+2*IN+1 ), IM,
     $                   IWORK, W( M+1 ), IBLOCK( M+1 ), IINFO )
            IF( IINFO .NE. 0 ) THEN
               INFO = IINFO
               RETURN
            END IF
<span class="comment">*</span><span class="comment">
</span>            NWL = NWL + IWORK( 1 )
            NWU = NWU + IWORK( IN+1 )
            IWOFF = M - IWORK( 1 )

<span class="comment">*</span><span class="comment">           Compute Eigenvalues
</span>            ITMAX = INT( ( LOG( GU-GL+PIVMIN )-LOG( PIVMIN ) ) /
     $              LOG( TWO ) ) + 2
            CALL <a name="SLAEBZ.530"></a><a href="slaebz.f.html#SLAEBZ.1">SLAEBZ</a>( 2, ITMAX, IN, IN, 1, NB, ATOLI, RTOLI, PIVMIN,
     $                   D( IBEGIN ), E( IBEGIN ), E2( IBEGIN ),
     $                   IDUMMA, WORK( N+1 ), WORK( N+2*IN+1 ), IOUT,
     $                   IWORK, W( M+1 ), IBLOCK( M+1 ), IINFO )
            IF( IINFO .NE. 0 ) THEN
               INFO = IINFO
               RETURN
            END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">           Copy eigenvalues into W and IBLOCK
</span><span class="comment">*</span><span class="comment">           Use -JBLK for block number for unconverged eigenvalues.
</span><span class="comment">*</span><span class="comment">           Loop over the number of output intervals from <a name="SLAEBZ.541"></a><a href="slaebz.f.html#SLAEBZ.1">SLAEBZ</a>
</span>            DO 60 J = 1, IOUT
<span class="comment">*</span><span class="comment">              eigenvalue approximation is middle point of interval
</span>               TMP1 = HALF*( WORK( J+N )+WORK( J+IN+N ) )
<span class="comment">*</span><span class="comment">              semi length of error interval
</span>               TMP2 = HALF*ABS( WORK( J+N )-WORK( J+IN+N ) )
               IF( J.GT.IOUT-IINFO ) THEN
<span class="comment">*</span><span class="comment">                 Flag non-convergence.
</span>                  NCNVRG = .TRUE.
                  IB = -JBLK
               ELSE
                  IB = JBLK
               END IF
               DO 50 JE = IWORK( J ) + 1 + IWOFF,
     $                 IWORK( J+IN ) + IWOFF
                  W( JE ) = TMP1
                  WERR( JE ) = TMP2
                  INDEXW( JE ) = JE - IWOFF
                  IBLOCK( JE ) = IB
   50          CONTINUE
   60       CONTINUE
<span class="comment">*</span><span class="comment">
</span>            M = M + IM
         END IF
   70 CONTINUE

<span class="comment">*</span><span class="comment">     If RANGE='I', then (WL,WU) contains eigenvalues NWL+1,...,NWU
</span><span class="comment">*</span><span class="comment">     If NWL+1 &lt; IL or NWU &gt; IU, discard extra eigenvalues.
</span>      IF( IRANGE.EQ.INDRNG ) THEN
         IDISCL = IL - 1 - NWL
         IDISCU = NWU - IU
<span class="comment">*</span><span class="comment">
</span>         IF( IDISCL.GT.0 ) THEN
            IM = 0
            DO 80 JE = 1, M
<span class="comment">*</span><span class="comment">              Remove some of the smallest eigenvalues from the left so that
</span><span class="comment">*</span><span class="comment">              at the end IDISCL =0. Move all eigenvalues up to the left.
</span>               IF( W( JE ).LE.WLU .AND. IDISCL.GT.0 ) THEN
                  IDISCL = IDISCL - 1
               ELSE
                  IM = IM + 1
                  W( IM ) = W( JE )
                  WERR( IM ) = WERR( JE )
                  INDEXW( IM ) = INDEXW( JE )
                  IBLOCK( IM ) = IBLOCK( JE )
               END IF
 80         CONTINUE
            M = IM
         END IF
         IF( IDISCU.GT.0 ) THEN
<span class="comment">*</span><span class="comment">           Remove some of the largest eigenvalues from the right so that
</span><span class="comment">*</span><span class="comment">           at the end IDISCU =0. Move all eigenvalues up to the left.
</span>            IM=M+1
            DO 81 JE = M, 1, -1
               IF( W( JE ).GE.WUL .AND. IDISCU.GT.0 ) THEN
                  IDISCU = IDISCU - 1
               ELSE
                  IM = IM - 1
                  W( IM ) = W( JE )
                  WERR( IM ) = WERR( JE )
                  INDEXW( IM ) = INDEXW( JE )
                  IBLOCK( IM ) = IBLOCK( JE )
               END IF
 81         CONTINUE
            JEE = 0
            DO 82 JE = IM, M
               JEE = JEE + 1
               W( JEE ) = W( JE )
               WERR( JEE ) = WERR( JE )
               INDEXW( JEE ) = INDEXW( JE )
               IBLOCK( JEE ) = IBLOCK( JE )
 82         CONTINUE
            M = M-IM+1
         END IF

         IF( IDISCL.GT.0 .OR. IDISCU.GT.0 ) THEN
<span class="comment">*</span><span class="comment">           Code to deal with effects of bad arithmetic. (If N(w) is
</span><span class="comment">*</span><span class="comment">           monotone non-decreasing, this should never happen.)
</span><span class="comment">*</span><span class="comment">           Some low eigenvalues to be discarded are not in (WL,WLU],
</span><span class="comment">*</span><span class="comment">           or high eigenvalues to be discarded are not in (WUL,WU]
</span><span class="comment">*</span><span class="comment">           so just kill off the smallest IDISCL/largest IDISCU
</span><span class="comment">*</span><span class="comment">           eigenvalues, by marking the corresponding IBLOCK = 0
</span>            IF( IDISCL.GT.0 ) THEN
               WKILL = WU
               DO 100 JDISC = 1, IDISCL
                  IW = 0
                  DO 90 JE = 1, M
                     IF( IBLOCK( JE ).NE.0 .AND.
     $                    ( W( JE ).LT.WKILL .OR. IW.EQ.0 ) ) THEN
                        IW = JE
                        WKILL = W( JE )
                     END IF
 90               CONTINUE
                  IBLOCK( IW ) = 0
 100           CONTINUE
            END IF
            IF( IDISCU.GT.0 ) THEN
               WKILL = WL
               DO 120 JDISC = 1, IDISCU
                  IW = 0
                  DO 110 JE = 1, M
                     IF( IBLOCK( JE ).NE.0 .AND.
     $                    ( W( JE ).GE.WKILL .OR. IW.EQ.0 ) ) THEN
                        IW = JE
                        WKILL = W( JE )
                     END IF
 110              CONTINUE
                  IBLOCK( IW ) = 0
 120           CONTINUE
            END IF
<span class="comment">*</span><span class="comment">           Now erase all eigenvalues with IBLOCK set to zero
</span>            IM = 0
            DO 130 JE = 1, M
               IF( IBLOCK( JE ).NE.0 ) THEN
                  IM = IM + 1
                  W( IM ) = W( JE )
                  WERR( IM ) = WERR( JE )
                  INDEXW( IM ) = INDEXW( JE )
                  IBLOCK( IM ) = IBLOCK( JE )
               END IF
 130        CONTINUE
            M = IM
         END IF
         IF( IDISCL.LT.0 .OR. IDISCU.LT.0 ) THEN
            TOOFEW = .TRUE.
         END IF
      END IF
<span class="comment">*</span><span class="comment">
</span>      IF(( IRANGE.EQ.ALLRNG .AND. M.NE.N ).OR.
     $   ( IRANGE.EQ.INDRNG .AND. M.NE.IU-IL+1 ) ) THEN
         TOOFEW = .TRUE.
      END IF

<span class="comment">*</span><span class="comment">     If ORDER='B', do nothing the eigenvalues are already sorted by
</span><span class="comment">*</span><span class="comment">        block.
</span><span class="comment">*</span><span class="comment">     If ORDER='E', sort the eigenvalues from smallest to largest
</span>
      IF( <a name="LSAME.678"></a><a href="lsame.f.html#LSAME.1">LSAME</a>(ORDER,<span class="string">'E'</span>) .AND. NSPLIT.GT.1 ) THEN
         DO 150 JE = 1, M - 1
            IE = 0
            TMP1 = W( JE )
            DO 140 J = JE + 1, M
               IF( W( J ).LT.TMP1 ) THEN
                  IE = J
                  TMP1 = W( J )
               END IF
  140       CONTINUE
            IF( IE.NE.0 ) THEN
               TMP2 = WERR( IE )
               ITMP1 = IBLOCK( IE )
               ITMP2 = INDEXW( IE )
               W( IE ) = W( JE )
               WERR( IE ) = WERR( JE )
               IBLOCK( IE ) = IBLOCK( JE )
               INDEXW( IE ) = INDEXW( JE )
               W( JE ) = TMP1
               WERR( JE ) = TMP2
               IBLOCK( JE ) = ITMP1
               INDEXW( JE ) = ITMP2
            END IF
  150    CONTINUE
      END IF
<span class="comment">*</span><span class="comment">
</span>      INFO = 0
      IF( NCNVRG )
     $   INFO = INFO + 1
      IF( TOOFEW )
     $   INFO = INFO + 2
      RETURN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment">     End of <a name="SLARRD.711"></a><a href="slarrd.f.html#SLARRD.1">SLARRD</a>
</span><span class="comment">*</span><span class="comment">
</span>      END

</pre>

 </body>
</html>
